(defpackage :printer
  (:use :cl)
  (:export :printer))

(in-package :printer)

(defclass key (gwee:button)
  ()
  (:default-initargs
   :height :maximum
   :width :maximum
    :click-callback 'click))

(defclass box-maker (tv:basic-tree-view)
  ((box :initform [m] :accessor box))
  (:default-initargs
   :background (gwee:color 200 150 250)))

(defun space-box (obj)
  (d:funcall-on-tree (lambda (x) (setf (geom:x x) 0 (geom:y x) 0) (d:space-node x obj))
                     (box obj)
                     :when :after))

(defmethod gwee:draw-view ((obj box-maker))
  (space-box obj)
  (d:move-tree (box obj)
               (u:half (- (gwee:view-width obj) (geom:width (box obj))))
               (u:half (- (gwee:view-height obj) (geom:height (box obj))))
               t)
  (d:funcall-on-tree (u:curry d:draw-node (box) obj) (box obj)))

(defun click (b)
  (labels ((op (arg)
             (find (d:quantity arg) '(+ - / *)))
           (num (arg)
             (numberp (d:quantity arg)))
           (new (box data)
             (setf (tree:children box)
                   (append (tree:children box)
                           (list [a data]))))
           (last (box)
             (u:last1 (tree:children box)))
           (del (box)
             (setf (tree:children box) (butlast (tree:children box)))))
    (let* ((c (gwee:component-for-view b))
           (data (gwee:callback-data b))
           (box (box (slot-value c 'input))))
      (cond
        ((eq data :backspace)
         (when (last box)
           (if (numberp (d:quantity (last box)))
               (progn
                 (setf (d:quantity (last box)) (truncate (d:quantity (last box)) 10))
                 (when (zerop (d:quantity (last box)))
                   (del box)))
                 (del box))))
        ((find data '(+ - / *))
         (if (tree:children box)
             (when (< (length (tree:children box)) 3)
               (if (not (op (last box)))
                   (new box data)
                   (setf (d:quantity (last box)) data)))
             (progn
               (new box nil)
               (new box data))))
        ((or (null (tree:children box))
             (op (last box)))
         (when (or (numberp data)
                   (eq data '-))
           (new box data)))
        (t
         (let ((arg (last box)))
           (setf (d:quantity arg)
                 (if (d:quantity arg)
                     (+ (* (d:quantity arg) 10) data)
                     data)))))
      (setf (gwee:view-needs-update-p (slot-value c 'input)) t))))

(gwee:define-component printer ()
  ((print-callback :initarg :print-callback :accessor print-callback))
  (:views
   (input box-maker
          :width :maximum
          :height 70)
   (submit gwee:button :data "Print" :width :maximum :click-callback 'print-box)
   (b1 key :data "1" :callback-data 1)
   (b2 key :data "2" :callback-data 2)
   (b3 key :data "3" :callback-data 3)
   (b4 key :data "4" :callback-data 4)
   (b5 key :data "5" :callback-data 5)
   (b6 key :data "6" :callback-data 6)
   (b7 key :data "7" :callback-data 7)
   (b8 key :data "8" :callback-data 8)
   (b9 key :data "9" :callback-data 9)
   (b0 key :data "0" :callback-data 0)
   (b+ key :data "+" :callback-data '+)
   (b- key :data (string (code-char 8722)) :callback-data '-)
   (b* key :data (string (code-char 215)) :callback-data '*)
   (b/ key :data (string (code-char 247)) :callback-data '/)
   (backspace key :data (string (code-char 8592)) :callback-data :backspace)
   (bfraction key :data "/" :callback-data :fraction))
  (:layouts
   (default gwee:column-layout
       (input submit row1 row2 row3 row4)
     :border-color gwee:*default-foreground-color*
     :margin 10
     :padding 3)
   (row1 gwee:row-layout (b7 b8 b9 b+) :padding 3)
   (row2 gwee:row-layout (b4 b5 b6 b-) :padding 3)
   (row3 gwee:row-layout (b1 b2 b3 b*) :padding 3)
   (row4 gwee:row-layout (b0 backspace bfraction b/) :padding 3)))

(defun print-box (button)
  (let* ((c (gwee:component-for-view button))
         (b (box (slot-value c 'input))))
    (when (plusp (length (tree:children b)))
      (when (= (length (tree:children b)) 2)
        (print `(hoeu))
        (setf (tree:children b) (append (tree:children b) (list [a nil])))
        (space-box (slot-value c 'input)))
      (funcall (print-callback c) c (tree:copy-node b t))
      (setf (box (slot-value c 'input)) [m]))))
